perm filename M11A.F4[M11,LCS]2 blob sn#396929 filedate 1978-11-22 generic text, type T, neo UTF8
00100	CPASS3     PASS 3 MAIN PROGRAM  
00200	C    *** MUSIC V ***     
00300	      INTEGER PEAK,CONV
00400	CXX	DOUBLE PRECISION JFLNM,JTRNS,JBLA
00500	      DIMENSION T(50),TI(50),ITI(50)   
00600	CSS   COMMON I(513) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,RPEAK,NBUF
00700	      COMMON I(513) /P/P(50) /FINOUT/PEAK,RPEAK,NBUF
00800		1 /GENS/GENS(3072) /IRAN/IRAN /CONV/CONV,INIOUT,JFLNM
00900		1 /LFUNC/LFUNC
01000	
01100	C NOPCD=NUM.OF OP CODES, ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
01200		DATA NOPCD/14/, ISRT/10000/, LFUNC/512/
01300		1 , NPAR/35/, NINS/27/, LBLK/512/
01400	C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
01500	
01600		COMMON /INS/INS(400),IDEF(100) /NT/RNT(1000) /ROUT/ROUT(3072)
01700	C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, ROUT=OUTPUT BLOCK (B1→B6)(6*512)
01800		EQUIVALENCE (I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3))
01900		1, (I5,I(5)),(I6,I(6))
02000		DATA JTRNS/'TRNS '/,JBLA/'    '/
02100	      DATA IIIRD/976545367/     
02200	C     INIALIZATION OF PIECE     
02300	C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
02400	CXX	IRAN=32767
02500	CXX	IRAN=I(7)+1
02600	      IRAN=IIIRD
02700		NBUF=512
02800		INIOUT=-1
02900	C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
03000	      PEAK=0      
03100	CSS	IPEAK=0
03200		RPEAK=0
03300	C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
03400	CC*******    NREAD = 3   
03500	CC*******    NWRITE = 2  
03600	      NREAD=21
03700	C   PDP DSK1=DEV.21
03800	      NWRITE=1
03900	C   PDP DSK=DEV.1
04000	CXX   REWIND NREAD
04100	CXX   REWIND NWRITE      
04200	44    TYPE 401  
04300	      ACCEPT 501,JFLNM,CONV
04400	C  TYPE <CR> FOR DEFAULT NAME(FOR21.DAT), ADD A NUM. TO WRITE SMPLS TO BE PLAYED.
04500	      IF(JFLNM.EQ.JBLA)JFLNM=JTRNS  
04600	CXX	CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
04700	         CALL IFILE(21,JFLNM)
04800	C  OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
04900	401   FORMAT(' TYPE FILE NAME'/)
05000	501   FORMAT(A5,5I)
05100	      I2=1      
05200		MS1=1
05300	      MS3=MS1+(NPAR*NINS)-1   
05400	      MS2=NPAR   
05500	      I(4)=ISRT   
05600	      MOUT=1      
05700	
05800	C     INITIALIZATION OF SECTION 
05900	5     T(1)=0.0    
06000	      DO 220 N1=MS1,MS3,MS2
06100	C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
06200	 220  RNT(N1)=-1    
06300	      DO 221 N1=1,NINS      
06400	 221  TI(N1)=90909.  
06500	
06600	C     MAIN CARD READING LOOP    
06700	  204 CALL DATA (NREAD)  
06800	      IF(P(2)-T(1))200,200,244  
06900	 200  IOP=P(1)    
07000	      IF(IOP)201,201,202 
07100	 201  CALL ERROR(1)
07200	      GO TO 204     
07300	
07400	 202  IF(NOPCD-IOP)201,203,203  
07500	 203  GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP    
07600	 11   IVAR=P3   
07700	      IVARE=IVAR+I(1)-4  
07800	      DO  297 N1=IVAR,IVARE      
07900	      IVARP=N1-IVAR+4    
08000	 297  I(N1)=P(IVARP)     
08100	C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
08200		IF(N1.EQ.8)NBUF=512+512*I(N1)
08300	C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
08400	      GO TO 204     
08500	 3    IGEN=P3   
08600	      IF(IGEN.NE.1)GO TO 282
08700	CCC **** ONLY GEN1,GEN2 IN THIS VERSION  GO TO (281,282,283,284,285),IGEN   
08800	 281  CALLGEN1    
08900	      GO TO 204     
09000	 282  IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
09100	      CALLGEN2    
09200	      GO TO 204     
09300	
09400	 4    IVAR=P3   
09500	      IVARE=IVAR+I(1)-4  
09600	      DO 296N1=IVAR,IVARE 
09700	      IVARP=N1-IVAR+4    
09800	 296  I(N1+100)=P(IVARP)
09900	      GO TO 204     
10000	    6 CALL FROUT3(IDSK)
10100	      STOP 
10200	
10300	C     ENTER NOTE TO BE PLAYED   
10400	 1    DO 230N1=MS1,MS3,MS2
10500	230   IF(RNT(N1).EQ.-1)GO TO 231      
10600	      CALL ERROR(2)
10700	C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
10800		TYPE 1230,NINS
10900	      GO TO 204     
11000	1230	FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
11100	 231  M1=N1
11200	      M2=N1+I(1)-1
11300	      M3=M2+1     
11400	      M4=N1+NPAR-1      
11500	      DO 232N1=M1,M2      
11600	      M5=N1-M1+1  
11700	 232  RNT(N1)=P(M5)
11800	      RNT(M1  )=P3
11900	      DO 233N1=M3,M4      
12000	 233  RNT(N1)=0     
12100	      DO 235N1=1,NINS      
12200	      IF(TI(N1)-90909.)235,234,235   
12300	 234  TI(N1)=P(2)+P(4)   
12400	      ITI(N1)=M1  
12500	      GO TO 204     
12600	 235  CONTINUE    
12700	      CALL ERROR(3)
12800	      GO TO 204     
12900	
13000	C     DEFINE INSTRUMENT  
13100	 2    M1=I2     
13200	      M2=IFIX(P3)
13300	      IDEF(M2)=M1    
13400	  218 CALL DATA (NREAD)  
13500	      IF(I(1)-2)210,210,211     
13600	 210  INS(M1)=0     
13700	      I2=M1+1   
13800	      GO TO 204     
13900	 211  INS(M1)=P3  
14000	      M3=I(1)     
14100	      INS(M1+1)=M1+M3-1    
14200	      M1=M1+2     
14300	      DO 217N1=4,M3
14400	      M5=P(N1)    
14500	      IF(M5)212,213,213  
14600	 212  IF(M5+100)300,301,301     
14700	 300  INS(M1)=-1+(M5+101)*LFUNC      
14800	      GO TO 216     
14900	 301  INS(M1)=-1+(M5+1)*LBLK      
15000	      GO TO 216     
15100	 213  IF(M5- 100 )214,214,215   
15200	 214  INS(M1)=M5    
15300	      GO TO 216     
15400	 215  INS(M1)=M5+26262     
15500	C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
15600	C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
15700	 216  M1=M1+1     
15800	 217  CONTINUE    
15900	      GO TO 218     
16000	
16100	C     PLAY TO ACTION TIME
16200	 244  T2=P(2)   
16300	 250  TMIN=90909.    
16400	      IREST=1     
16500	      DO 241N1=1,NINS      
16600	      IF(TMIN-TI(N1))241,241,240
16700	 240  TMIN=TI(N1) 
16800	      MNOTE=N1    
16900	 241  CONTINUE    
17000	      IF(90909.-TMIN)251,251,243     
17100	 243  IF(TMIN-T2)245,245,246  
17200	 245  T3=TMIN   
17300	      GO TO 260     
17400	 246  T3=T2   
17500	      GO TO 260     
17600	 247  IF(T(1)-T2)249,200,200  
17700	 249  TI(MNOTE)=90909.
17800	      M2=ITI(MNOTE)      
17900	      RNT(M2)=-1    
18000	      GO TO 250     
18100	
18200	C     SETUP REST  
18300	 251  T3=T2   
18400	      IREST=2     
18500	      GO TO 260     
18600	
18700	C     PLAY 
18800	 260  ISAM=(T3-T(1))*FLOAT(I(4))+.5  
18900	      T(1)=T3   
19000	      IF(ISAM)247,247,266
19100	 266  IF(ISAM-LBLK)262,262,263
19200	 262  I5=ISAM   
19300	      ISAM=0      
19400	      GO TO 264     
19500	 263  I5=LBLK 
19600	      ISAM=ISAM-LBLK   
19700	 264  IF(I(8))290,290,291
19800	 290  M3=MOUT+I5-1     
19900	      MSAMP=I5  
20000	      GO TO 292     
20100	 291  M3=MOUT+(2*I5)-1 
20200	      MSAMP=2*I5
20300	 292  DO 267N1=MOUT,M3    
20400	 267  ROUT(N1)=0     
20500	      GO TO (268,265),IREST
20600	
20700	 268  DO 270 NS1=MS1,MS3,MS2      
20800	      IF(RNT(NS1)+1)271,270,271   
20900	C     GO THROUGH UNIT GENERATORS IN INSTRUMENT
21000	 271  I(3)=NS1    
21100	      IGEN=RNT(NS1)  
21200	      IGEN=IDEF(IGEN)  
21300	 272  I6=IGEN   
21400	 294  CALL FORSAM  
21500	 295  IGEN=INS(IGEN+1)     
21600	      IF(INS(IGEN))270,270,272    
21700	 270  CONTINUE    
21800	 265  CALL SAMOUT(IDSK ,MSAMP)
21900	      IF(ISAM)247,247,266
22000	      END  
22100	
22200	CDATA3     PASS 3 DATA INPUTING ROUTINE
22300	      SUBROUTINE DATA (N)
22400	      COMMON I(1)/P/ P(1) /FINOUT/PEAK,RPEAK
22500	CSS      COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK
22600		EQUIVALENCE (K,I),(P2,P(2))
22700	      READ (N)  K,(P(J),J=1,K)  
22800		IF(P(1).EQ.1)TYPE 1,P2
22900		IF(PEAK.LE.RPEAK)RETURN
23000	CSS	IF(JPEAK.LE.IPEAK)RETURN
23100		TYPE 2,PEAK
23200	CSS	TYPE 2,JPEAK
23300		RPEAK=PEAK
23400	CSS	IPEAK=JPEAK
23500	C  TYPES OUT EACH NEW PEAK AMPL.
23600	      RETURN      
23700	1	FORMAT('+',F9.2,$)
23800	2	FORMAT('+   AMPL=',F5.0,$)
23900	CSS2	FORMAT('+   AMPL=',I4,$)
24000	      END  
24100	
24200	      SUBROUTINE FROUT3(IDSK) 
24300	C   TERMINATE OUTPUT     
24400		COMMON  /ROUT/ROUT(1)  /FINOUT/PEAK /CONV/CONV
24500		DO 1 K=1,512
24600	1	ROUT(K)=0
24700	      CALL SAMOUT(IDSK,512)
24800	      TYPE 10,PEAK
24900		IF(CONV.EQ.0)CALL EXIT
25000		CALL FINFIL
25100		TYPE 2
25200	2	FORMAT(' 11.DMD WAS WRITTEN ********')
25300	      CALL EXIT
25400	   10 FORMAT ('0PEAK AMPLITUDE WAS ',F7.0)
25500	      END